home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Amiga Public Domain Connection / APDC Disk #025 - Programming Languages (198x)(Amiga Public Domain Connection)(US)[m][WB].zip / APDC Disk #025 - Programming Languages (198x)(Amiga Public Domain Connection)(US)[m][WB].adf / Modula-2 / m2 / InfoTest.MOD < prev    next >
Text File  |  1988-03-15  |  3KB  |  108 lines
  1. (********************************************************************************
  2.  
  3. Name         : InfoTest.MOD
  4. Version      : 1.0
  5. Purpose      : Try to get infos
  6. Author       : ms
  7. Modified     : 2.4.86  15:35  ms
  8.  
  9. ********************************************************************************)
  10.  
  11. MODULE InfoTest;
  12.  
  13. FROM Terminal   IMPORT Read, BusyRead, Write, WriteLn, WriteString;
  14. FROM AMIGADos   IMPORT AMIGAInfoData, AMIGALockPtr, Info, Lock, UnLock;
  15.  
  16. CONST   bs  = 10C;
  17.         lf  = 12C;
  18.         ff  = 14C;
  19.         cr  = 15C;
  20.         esc = 33C;
  21.         del =177C;
  22.  
  23. PROCEDURE ReadString(VAR st: ARRAY OF CHAR);
  24.   VAR pos: CARDINAL;
  25.       ch: CHAR;
  26. BEGIN
  27.   pos:=0;
  28.   LOOP
  29.     Read(ch);
  30.     IF (ch=' ')  OR (ch=cr) OR (ch=lf) THEN
  31.       IF pos<=HIGH(st) THEN st[pos]:=0C END;
  32.       EXIT
  33.     ELSIF ch=esc THEN
  34.       st[0]:=0C;
  35.       EXIT
  36.     ELSIF (ch=del) & (pos>0) THEN
  37.       Write(del); DEC(pos);
  38.     ELSIF (ch=bs) & (pos>0) THEN
  39.       Write(bs); DEC(pos);
  40.     ELSIF (ch>' ') & (pos<HIGH(st)) THEN
  41.       st[pos]:=ch;
  42.       Write(ch);
  43.       INC(pos)
  44.     ELSE
  45.     END
  46.   END
  47. END ReadString;
  48.  
  49. PROCEDURE WriteLong(p:LONGINT);
  50.  VAR i:CARDINAL; s:ARRAY [0..9] OF CHAR;
  51. BEGIN
  52.   s:='          ';
  53.   i:=9;
  54.   WHILE p#0D DO
  55.     s[i]:=CHR(CARDINAL(p MOD 10D)+48); p:=p DIV 10D; DEC(i)
  56.   END;
  57.   WriteString(s);
  58. END WriteLong;
  59.  
  60.   VAR lock: AMIGALockPtr;
  61.       infoData: AMIGAInfoData;
  62.       name: ARRAY [0..31] OF CHAR;
  63.       ok: BOOLEAN;
  64.       ch: CHAR;
  65. BEGIN
  66.   WriteString('InfoTest          5.3.86'); WriteLn;
  67.   WriteString('========================'); WriteLn;
  68.   WriteLn;
  69.   WriteString('get info to > '); ReadString(name); WriteLn;
  70.   WriteLn;
  71.   WriteString('lock '); WriteString(name); WriteString(' ...');
  72.   lock:=Lock(name, FALSE);
  73.   IF LONGINT(lock)#0D THEN
  74.     WriteString('done'); WriteLn;
  75.     WriteString('info ... ');
  76.     Info(lock, infoData, ok);
  77.     IF ok THEN
  78.       WriteString('done'); WriteLn;
  79.       WITH infoData DO
  80.         WriteString('numSoftErrors :'); WriteLong(numSoftErrors); WriteLn;
  81.         WriteString('unitNumber    :'); WriteLong(unitNumber); WriteLn;
  82.         WriteString('diskState     :'); WriteLong(diskState); WriteLn;
  83.         WriteString('numBlocks     :'); WriteLong(numBlocks); WriteLn;
  84.         WriteString('numBlocksUsed :'); WriteLong(numBlocksUsed); WriteLn;
  85.         WriteString('bytesPerBlock :'); WriteLong(bytesPerBlock); WriteLn;
  86.         WriteString('diskType      :');
  87.         IF diskType.val=-1D THEN WriteString('no disk present')
  88.         ELSE WriteString(diskType.typ)
  89.         END;
  90.         WriteLn;
  91.         WriteString('volumeNode    :'); WriteLong(volumeNode); WriteLn;
  92.         WriteString('inUse         :'); WriteLong(inUse); WriteLn
  93.       END
  94.     ELSE
  95.       WriteString('not done'); WriteLn
  96.     END;
  97.     UnLock(lock);
  98.   ELSE
  99.     WriteString('not done'); WriteLn
  100.   END;
  101.   WriteLn;
  102.   WriteString('-- press any key to continue (BusyRead)');
  103.   REPEAT BusyRead(ch) UNTIL ch#0C;
  104.   WriteLn;
  105.   WriteString('-- press any key to continue');
  106.   Read(ch);
  107. END InfoTest.MOD
  108.